C ********** EARLY MUSIC NOTATION PACKAGE ************
C TO CHANGE CONVENTIONAL NOTATION ENTERED WITH '14' OR '144' TO EARLY MUSIC
C NOTATION, ADD 500 TO P4 OF ALL NOTES AND RESTS. (USE 'A' COMMAND.)
C THE VARIOUS NOTE SHAPES ARE DETERMINED BY THE RHYTHMIC VALUE FOUND IN P9
C (OR P7 WITH RESTS).  THE SAME SHAPES CAN BE MADE BY PUTTING VALUES IN P6 IF
C P9=0.  THE FOLLOWING TABLE SHOWS NUMBERS FOR BOTH METHODS.  THE RHYTHMIC
C VALUE (P9 OR P7) COMES BEFORE THE SHAPE NAME.  THE P6 VALUES FOLLOW EACH NAME.
C THE STANDARD NOTE VALUES WOULD BE: DOUBLE WHOLE, WHOLE, 1/2, 1/4, 1/8, 1/16.
C  8 = MAXIMA = 20;      4 = LONGA = 21;   2 = BREVIS = 22;
C  1 = SEMIBREVE = 23;  .5 = MINIM = 24;  .25 = SEMIMINIM = 25;

C  SET 'COLORATION' IN P8 IF NOT SET BY RHYTH.(P9)  -1=BLACK, 0=WHITE HERE.

C MENSURATION SIGNS ARE CONSIDERED TO BE A FORM OF 'NOTE'.  THE VERTICAL
C POSITION IS SET IN P4 WITH THE 'ZERO' LEVEL BEING IN THE SECOND SPACE FROM
C THE BOTTOM OF THE STAFF. (POSITION OF NOTE 'A'.)
C SET P9 TO 0 AND P6 AS FOLLOWS.
C MENSURATION SIGNS: P6 =30=C; 31=C WITH DOT IN MIDDLE; 32=C WITH SLASH; 
C  			33=O; 34=O WITH SLASH.

C  LIGATURES ARE CREATED FROM COMBINATIONS OF MAXIMA, LONGA AND BREVIS SHAPES
C  OR, FOR THE SLOPED SHAPES, BY SETTING P9=0 AND P6 EQUAL TO SOME NUMBER FROM
C  11 TO 19.  FOR SLOPES IT IS THE SECOND DIGIT OF THE NUMBER THAT DETERMINES
C  THE GOAL OF THE SLOPE.  IF THE NUMBER IS NEGATIVE THE SLOPE WILL BE DOWNWARD.
C    P4=504  P6=11 WILL MAKE A SLOPE FROM F (TREBLE CLEF) UP TO G.
C    IF P6=14 THE SLOPE WILL BE FROM F UP TO C.  P4=508  P6=-14 WILL GIVE A
C    SLOPE DOWN FROM C TO F.

C TO MOVE ANY SLOPING LIGATURE EXACTLY ITS OWN WIDTH TO THE LEFT (FOR COMB-
C INED LIGATURES) SET P9 TO -1.  P3 WILL THEN INDICATED THE POSITION OF ITS
C RIGHT SIDE INSTEAD OF ITS LEFT SIDE.

C  FOR THE COMBINATION LIGATURES, FIRST SET P9 TO 0. NEXT THE RIGHT HAND
C SQUARE WILL BE SET.  P6=22 GIVES A SIMPLE SQUARE WITH NO STEM.(BREVIS)
C FOR A DESCENDING STEM ON THE RIGHT SIDE, P6=21.(LONGA)
C FOR AN ASCENDING STEM ON THE RIGHT SIDE, P6=29.
C FOR A STEM ON THE LEFT SIDE OF THE SQUARE SET P7 TO A NEGATIVE NUMBER.
C THE ABSOLUTE VALUE OF THIS NUMBER WILL DETERMINE THE LENGTH OF THE STEM.
C THE DIRECTION OF THIS LEFT STEM IS SET IN P5. UP, P5=10; DOWN, P5=20.

C THE LEFT HAND SQUARE IS IS BEST ENTERED BY MAKING A COPY OF THE RIGHT ONE.
C WITH THE COPY, WHEN P5 IS SET TO -1 THE SQUARE PIVOTS ON ITS LEFT SIDE.
C THIS NEW NOTE MAY BE MOVED UP OR DOWN TO THE PROPER POSITION.  AS A
C RESULT OF THIS PIVOTING A STEM THAT WAS ORIGINALLY ON THE RIGHT SIDE NOW
C APPEARS ON THE LEFT SIDE.(STEM UP, P6=21; DOWN, P6=29)  NO STEM CAN BE
C PUT ON THE RIGHT SIDE OF A REVERSED NOTE.  ANY STEM NEEDED IN THE CENTRAL
C POSITION, BETWEEN THE TWO SQUARES, CAN BE ADDED TO THE RIGHT HAND NOTE BY
C PUTTING THE PROPER VALUES IN P7 (NEGATIVE) AND P5 (10=↑, 20=↓).  BY
C CHANGING THE VALUES OF P7 THIS CENTRAL STEM MAY BE USED TO CONNECT THE
C TWO NOTES TOGETHER AS WELL AS TO EXTEND BEYOND THE LEFT HAND NOTE.
C BY USING THIS PIVOTING METHOD BOTH HALVES OF A TWO NOTE LIGATURE WILL
C WILL HAVE THE SAME HORIZANTAL POSITION IN P3, WHICH WILL INDICATE THE
C CENTER OF THE LIGATURE.

	SUBROUTINE EXTRA 
	IMPLICIT INTEGER(A-Q,S-Z)
	REAL POS
	COMMON /STF/RSTFAC(-3/4),RSTJ2
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RB,RZ,RJY,
	1 QQ,RJW,ZZ,JX,RG,KL,RJAC,K,L,RQ,RXO,J5X,RNO,JJJ,
	1 PUNCT,RDIS,RJ,ALF73
	EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(NJR,RJQ(8)),
	1 (J6,JQ(4)),(R8,RJQ(6)),(R7,RJQ(5)),(R9,RJQ(7)),(J9,JQ(7))
	1,(J4,JQ(2)),(R3,RJQ(1)),(J10,JQ(8)),(R11,RJQ(9)),(J8,JQ(6))
	1,(J7,JQ(5)),(RX3,RJQ(20)),(R5,RJQ(3)),(RH,RJQ(19)),(RXX,RJQ(18))
	1,(J3,JQ(1)),(NOLEDG,JQ(9))
	DATA RBIG/1.5/,RLIG/2.0/

	NOLEDG=J9
C   P9=-1 SUPRESSES LEDGER LINE
	IF(JA.EQ.2)R9=R7
	KL=IABS(J6)
	IF(KL.GT.5)GO TO 10
	IF(R9.GT.0)GO TO 2
10	IF(JA.EQ.1)J5=J6
	IF(KL.GE.30)GO TO 30
C  JUMP FOR MENSURATION SIGNS.
C  PUT NUM. IN P6 IF P9 NOT USED. 20=MAXIMA, 21=LONGA, 22=BREVIS, ETC.
	IF(R8.GE.0)R8=-2
C  MAKES IT WHITE UNLESS -1 IS IN R8
	GO TO 3
2	RH=.75
	DO 21 K=1,5
	IF(R9.NE.RH)GO TO 21
	R9=R9*2
	R9=R9/3.
	GO TO 22
21	RH=RH*2.
22	RA=AMOD(R9,.25)
C  RA=0=WHITE,  ≠0='COLORATION'
	IF(RA.NE.0)R9=R9*1.5
C  TO GET THE RIGHT SHAPE
	J5=19.5+ALOG(16./R9)/.693147181
C  I.E. /ALOG(2.)  FINDS SEQ. NUM IN DRAW FILE 'EARLY'. 20=MAXIMA, ETC.
	R8=-1
C  FILL IT ALWAYS (BLACK NOTE)
	IF(RA.EQ.0)R8=-2
C  ALWAYS WHITE
3	IF(JA.EQ.2)GO TO 20
	RH=R5
	JA=3 
	K=J4
	RXX=POS-18.*RSTJ2
	IF(J5.LT.20)GO TO 6
C GO MAKE 'LIGATURES' P6=11=1 UP, =-11=1 DOWN, 12=2 UP, ETC.
	R6=RBIG
	NJR='CLEF2'
C  ↑↑↑ EQUIV. TO R10
	R7=RBIG
	IF(R5)R6=-R6
C  IF P5 IS NEG THEN ITEM MOVES TO LEFT EXACTLY ITS SPACE.
	J9=0
       J8=R8
       IF(J8.NE.-1)J8=-2
	IF(J5.NE.29)GO TO 17
	R7=-R7
	R4=R4-5.8
C  MAKES LONGA WITH STEM UP -- FOR LIGATURES
	J5=21
	GO TO 7
17	IF(J5.LT.23)GO TO 7
	IF(R8.EQ.-2)R8=0
C  FOR DIFFERENT 'FILL' SITUATIONS
7        CALL CLEFS
	IF(J5.LT.23)GO TO 18
	IF(R8.GE.0)GO TO 1
	IF(J5.EQ.29)GO TO 1
	J5=29
	R6=RBIG
	R7=RBIG
C THIS PUTS 'MIDDLE' IN SEMIBREVE, MINIM AND SEMIMINIM
	GO TO 7

18	IF(J7.GE.0)GO TO 1
C IF P7 IS NEG THERE WILL BE A STEM ON LFT SIDE =ABS(R7), P5 HAS UP-DN.
	RG=R4
	R5=-J7*RST7
	GO TO 14
6	RG=R4
C THIS WILL BE FOR LIGATURE STEMS (P5=10=UP, =20=DOWN)
	IF(KL.GT.10)GO TO 11
	R6=-R6*10.
	GO TO 12
11	R6=KL-10
	IF(J6)R6=-R6
12	RX7=-.1
	IF(R6)RX7=-RX7
	R4=R4+RX7
	R6=R6-RX7*2.
C  ABOVE TO ADJUST END POINTS OF TILTS.
	RX7=R7
	IF(J9)R3=R3-27.*RSTJ2
C  J7=-1= SHIFT IT TO LEFT IT'S WIDTH.
	RA=R3
	IF(J8)GO TO 9
	RJW=POS
5	R4=R4-.45
	J5=50
C  P8<0=BLACK LIG.   ≥0=WHITE LIG.
	J10=0
 	RXO=RLIG
	R8=3.9
	R11=R6
	R3=R3+13.85*RSTJ2
	RB=R3
	DO 55 JJJ=1,7 
	R9=RXO
	CALL ITMSUB
	POS=RJW
	R8=3.8
	R3=RB
55	RXO=RXO-.144
C  THICKENS HORIZ. SIDES
	R9=RXO
	GO TO 8
9	R4=R4-.95
	J9=0
	R5=R4+R6/RSTJ2
CC	R9=200
	J7=1
	R8=4.6
	R6=RX3+R8
	J10=14
C  MAKES SLOPED DASH, 14XTHICK
	IF(J9.EQ.0)GO TO 8
	R6=RX3
	J3=R3
8	CALL ITMSUB
	IF(RH.EQ.0)GO TO 13
	R5=ABS(RX7)
	IF(R5.EQ.0)R5=5
	R5=R5*RST7
14	RG=RG*RST7+RXX
	IF(RH.GE.20)R5=-R5
C NOW STEM IS DOWN. (-R5)
	CALL LINX(R3,RG,R3,RG+R5)
13	R4=RG
	J5=20
	R3=RA

1	IF(K.LT.502)GO TO 4
	IF(K.LT.513)RETURN
C  WILL NOW DO 1 LEDG. LINE ABOVE OR BELOW.
4	IF(NOLEDG)RETURN
	R4=RST7
	IF(K.GT.502)R4=13.*RST7
	R4=R4+RXX
	R5=20.
	IF(J5.EQ.20)R5=34.
	CALL LINX(R3-RST7,R4,R3+R5*RSTJ2,R4)

	RETURN

20	IF(R9.NE.0)J5=R5+23.
	RG=POS
C SAVE IT FOR SEMIMINIM REST HORIZANTAL
C  RESTS ARE SET BY RHYTHM(R9,7) OR IN J5 (20-25)
	R5=(J5-20)*2+3
	RA=R4
	IF(R5.GT.8.)R5=8.
	R5=R4+R5
C  RESTS (500+ IN P4) CAN BE MOVED UP OR DOWN
	R4=9
	IF(J5.GT.23)R4=7.
	R4=R4+RA
	J10=3
	J7=0
	R6=RX3
C ALL THIS MAKES VERT. LINE.
	CALL ITMSUB
	IF(J5.LT.25)RETURN
C NEXT IS FOR SEMIMINIM REST (1/16)
	R6=RX3+1.3
	R4=8+RA
	R5=R4
	POS=RG
	CALL ITMSUB
 	RETURN

C  MENSURATION SIGNS. USES P6 AS A NOTE. =30=C; 31=C.; 32=C/; 33=O; 34=O/
30	R4=R4+6
	CALL CENTX
C  P4=500 PUTS IT AT POS 6.
	R5=1
	J8=1
	IF(J5.GT.32)GO TO 31
C  NEXT ARE C'S
	J6=125
	J7=45
	GO TO 32
31	J6=0
	J7=0
32	CALL CIRCLE
	IF(J5.NE.31)GO TO 33
C  NEXT IS C.
	J5=0
	J6=0
	J7=0
	R5=.1
	GO TO 31
33	IF(J5.LT.32)RETURN
	IF(J5.EQ.33)RETURN
	R5=R4+1
	R4=R4-1
	R3=R3-11.*RSTJ2
	J7=0
	R6=RX3+2*RSTJ2
	CALL ITMSUB
	END